Background

Responsible Impact (ReAct) is a participatory exercise at the Department of Communication and Psychology that seeks to develop and explore the department’s impact ecosystem. By staff engagement and iterative focus groups, the project collects and assesses annotated real-time data based on registration of impact activities (knowledge dissemination, pathways and linkages) by researchers at the Department of Communication and Psychology at Aalborg University.

By applying a rich and comprehensive impact taxonomy developed by interactive feedback from researchers at the department combined with a user-friendly web-based registration interface, the project aims to capture the diverse impact profiles of the department’s heterogeneous research groups while at the same time allowing researchers to have significant influence on how their impact is represented and communicated.

This websites presents some of the project outcomes as interactive visualizations.

Taxonomy Usage

Column

All

Participation in Person

Participation by Proxy

Inflow

Demographics

Row

Participant Positions

Testi 1

Row

Relative Contribution Per Category by Position

Testi 3

Cases

Row

Svend Brinkman

Legend

Rikke Magnusen

Legend

Row

Rikke Kristine Nielsen

Legend

Music Therapy

Legend

Analysis

Column

Heatmap

Activity Diversity Value

Activity Diversity vs. Total Publications

Activity Diversity vs. Total BFI Points

Activity Diversity vs. Citations

Activity Diversity vs. Downloads

---
title: "ReAct // Data Analytics Dashboard"
output: 
  flexdashboard::flex_dashboard:
    theme: bootstrap
    vertical_layout: scroll 
    social: menu
    source: embed
---

```{r setup, include=FALSE,echo = FALSE,warning=FALSE}
library(flexdashboard)
require(tidyverse)
require(forcats)
require(tidytext)
require(silgelib)
require(ggthemes)
require(hrbrthemes)
require(patchwork)
require(scales)
require(plotly)
require(d3heatmap)
require(RColorBrewer)
require(sunburstR)

firstup <- function(x) {
  substr(x, 1, 1) <- toupper(substr(x, 1, 1))
  x
}

all_data_final <- read_csv("201201_all_data_final.csv")
#23.7.2021
# now we can actually use the final_data_210720
# which includes wegener and øhstrøm
#final_data_210720 <- read_delim("final_data_210720.csv", 
#    ";", escape_double = FALSE, trim_ws = TRUE)

#all_data_final <- 

#load the user_ids
user_ids_final <- read_csv("user_ids_final.csv")
#now lets modfiy it accordingly 
# accordingto Louise2 the following need to go
filter_users<-c('Dollerup, Sanne','Dahlstedt, Mats Palle','Glintborg, Chalotte',
                  'Larsen, Malene Charlotte','Lykke, Marianne')

add_missing_users<-tibble(vivo_id=c(NA,NA),
                          name=c('Øhrstrøm, Peter','Wegener, Charlotte'),
                          position=c('professor','associateprofessor'),
                          vbn_id=c(NA,NA),pure_id=c(NA,NA))

user_ids_final%>%
        filter(!name%in%filter_users)%>%
            bind_rows(add_missing_users)->user_ids_final

#load the pure infos i.e. vbn downloads, avg bfi etc.
pure_bfi_complete <-read_csv('pure_bfi_complete.csv')


all_data_final%>%
  pivot_longer(cols = -user_name, 
      names_to = 'category',values_to='count')%>%
        left_join(user_ids_final%>%
                        select(name,position),
                            by=c('user_name'='name'))%>%
            mutate(count=ifelse(is.na(count),
                                0,count))->all_data_final_long

all_data_final_long%>%
  mutate(category = str_replace(category,pattern = '_',replacement = ' - '))%>%
    separate(category,into = c('category','B'),sep = ' - ')%>%
      mutate(B = firstup(B))%>%
        unite(col = category,category,B,sep = ' - ')%>%
          mutate(category = firstup(category))%>%
            filter(!is.na(position))->all_data_final_long
    

#can only be loaded here after all_data_final_long is done
source('helpers_new.R')

all_data_final_long%>%
  mutate(count=ifelse(count>0,1,0))%>%
      group_by(category)%>%
        summarise(category_total=(sum(count)/n_distinct(user_name)))%>%
          mutate(top_category=case_when(
            category%in%ParticipationInPerson ~'ParticipationInPerson',
            category%in%ParticipationByProxy ~'ParticipationByProxy',
            category%in%Inflow ~'Inflow'))%>%
          mutate(top_category=factor(top_category,levels=c('ParticipationInPerson',
                                             'ParticipationByProxy','Inflow')),
                 category=as.factor(category))%>%
            mutate(category= reorder_within(category,
                                category_total,top_category))->taxonomy_plots


```

Background {data-icon="fa-book-open"} 
================================
[Responsible Impact (ReAct) is a participatory exercise at the Department of Communication and Psychology](https://www.communication.aau.dk/research/Research+Projects/react/) that seeks to develop and explore the department's impact ecosystem. By staff engagement and iterative focus groups, the project collects and assesses annotated real-time data based on registration of impact activities (knowledge dissemination, pathways and linkages) by researchers at the Department of Communication and Psychology at Aalborg University. 

By applying a rich and comprehensive impact taxonomy developed by interactive feedback from researchers at the department combined with a user-friendly web-based registration interface, the project aims to capture the diverse impact profiles of the department’s heterogeneous research groups while at the same time allowing researchers to have significant influence on how their impact is represented and communicated.

This websites presents some of the project outcomes as interactive visualizations.


Taxonomy Usage {data-icon="fa-bars"} 
================================
Column {.tabset}
-----------------------------------------------------------------------


### All {data-height=1200} 

```{r}

taxonomy_plots%>%ggplot(mapping=aes(x=category,y=category_total,
                                            fill=top_category))+
                              geom_col(aes(text=paste('Percentage:',
                                        round(category_total*100,2))))+coord_flip()+
                                scale_fill_manual(values = cols)+
                                  scale_y_continuous(labels = percent)+
                                      scale_x_reordered()+
                                           theme_minimal()+
                  labs(x='',y='Percentage of Participants',
                    fill='',title='')+
                theme(axis.text.y = element_text(size=7))->taxonomy_usage_all

ggplotly(taxonomy_usage_all,tooltip = c('text'))%>%
  layout(legend = list(orientation = "h",x = 0, y = -0.1))

```

### Participation in Person
```{r}
taxonomy_plots%>%filter(str_detect(top_category,'Person'))%>%
  ggplot(mapping=aes(x=category,y=category_total,
                                            fill=top_category))+
                              geom_col()+coord_flip()+
                                scale_fill_manual(values = cols)+
                                  scale_y_continuous(labels = percent)+
                                      scale_x_reordered()+
                                           theme_minimal()+
                  labs(x='',y='Percentage of Participants',
                    fill='',title='')+
                theme(axis.text.y = element_text(size=7))->taxonomy_usage_person

ggplotly(taxonomy_usage_person)
```

### Participation by Proxy 
```{r}
taxonomy_plots%>%filter(str_detect(top_category,'Proxy'))%>%
  ggplot(mapping=aes(x=category,
                     y=category_total,
                            fill=top_category))+
                              geom_col()+coord_flip()+
                                scale_fill_manual(values = cols)+
                                  scale_y_continuous(labels = percent)+
                                      scale_x_reordered()+
                                           theme_minimal()+
                  labs(x='',y='Percentage of Participants',
                    fill='',title='')+
                theme(axis.text.y = element_text(size=7))->taxonomy_usage_proxy

ggplotly(taxonomy_usage_proxy)
```

### Inflow 
```{r}
taxonomy_plots%>%filter(str_detect(top_category,'Inflow'))%>%
  ggplot(mapping=aes(x=category,y=category_total,
                                            fill=top_category))+
                              geom_col()+coord_flip()+
                                scale_fill_manual(values = cols)+
                                  scale_y_continuous(labels = percent)+
                                      scale_x_reordered()+
                                           theme_minimal()+
                  labs(x='',y='Percentage of Participants',
                    fill='',title='')+
                theme(axis.text.y = element_text(size=7))->taxonomy_usage_inflow

ggplotly(taxonomy_usage_inflow)
```

### Inputs {.sidebar}
-------------------------------------
Bla bla bla 




Demographics {data-icon="fa-users"} 
=====================================  

Row
-------------------------------------
   
### Participant Positions
```{r}
user_ids_final%>%
          group_by(position)%>%
              count()%>%ungroup%>%
                mutate(total=sum(n),percentage=n/total)%>%
  ggplot(aes(x=reorder(position,percentage),y=percentage))+
  geom_col(aes(text=paste('Percentage:',
                          round(percentage*100,2),'\nCount:',n)))+
          coord_flip()+
            scale_y_continuous(labels = percent)+
               labs(x='',y='Percentage of Participants',
                    fill='',title='')+theme_minimal()->demo_position

ggplotly(demo_position,tooltip = c('text'))
```

### Testi 1

```{r}
```

Row
---------------------------------------

### Relative Contribution Per Category by Position
```{r}
all_data_final_long%>%
  mutate(count=ifelse(count>0,1,0))%>%
          mutate(top_category=case_when(
            category%in%ParticipationInPerson ~'ParticipationInPerson',
            category%in%ParticipationByProxy ~'ParticipationByProxy',
            category%in%Inflow ~'Inflow'))%>%
          mutate(top_category=factor(top_category,levels=c('ParticipationInPerson',
                                             'ParticipationByProxy','Inflow')),
                 category=as.factor(category))%>%
                    group_by(position,top_category)%>%
                      summarise(total_count=sum(count))%>%
  ggplot(aes(x=reorder(position,total_count),y=total_count,fill=top_category))+
           geom_col()+coord_flip()+ 
            scale_fill_manual(values = cols)+theme_minimal()+
                labs(x='Position',
                  y='Total Contribution Per Top Category',fill='')->position_top_category_count

ggplotly(position_top_category_count)
```
### Testi 3

Cases {data-icon="fa-users"} 
=====================================  
```{r}
all_data_final_long%>%mutate(top_category=case_when(
  category%in%ParticipationInPerson ~'ParticipationInPerson',
  category%in%ParticipationByProxy ~'ParticipationByProxy',
  category%in%Inflow ~'Inflow'))%>%
  mutate(top_category=factor(top_category,levels=c('ParticipationInPerson',
                                                   'ParticipationByProxy','Inflow')))%>%
  mutate(category = str_remove(category,'Inflow - '))%>%
  mutate(helper = str_remove(category,' - '))%>%
  mutate(category = sub(x = category,pattern = ' .*',replacement = ''))%>%
  mutate(category = ifelse(category == helper,'Reference',category))%>%
  mutate(category=as.factor(category))%>%
  unite('sunburst_combo',c(top_category,category,helper),sep='-')%>%
      mutate(sunburst_combo = str_remove_all(sunburst_combo,pattern =' '))%>%
        select(user_name,V1=sunburst_combo,V2=count)->sunburst_data

tibble(
colors=c('blue','red','darkgreen',
          rep('#5B5BFF',8),
          rep('#B6B6FF',42),
          rep('#FF5B5B',5),
          rep('#FFB6B6',33),
          rep('#008300',4),
          rep('#C5FFC5',17)),
labels=c(c("ParticipationInPerson","ParticipationByProxy","Inflow"),
          sunburst_data%>%
            separate(V1,c('layer1','layer2','layer3'),sep = '-')%>%
            filter(layer1=='ParticipationInPerson')%>%pull(layer2)%>%unique,
          sunburst_data%>%
            separate(V1,c('layer1','layer2','layer3'),sep = '-')%>%
            filter(layer1=='ParticipationInPerson')%>%pull(layer3)%>%unique,
          sunburst_data%>%
            separate(V1,c('layer1','layer2','layer3'),sep = '-')%>%
            filter(layer1=='ParticipationByProxy')%>%pull(layer2)%>%unique,
          sunburst_data%>%
            separate(V1,c('layer1','layer2','layer3'),sep = '-')%>%
            filter(layer1=='ParticipationByProxy')%>%pull(layer3)%>%unique,
          sunburst_data%>%
            separate(V1,c('layer1','layer2','layer3'),sep = '-')%>%
            filter(layer1=='Inflow')%>%pull(layer2)%>%unique,
          sunburst_data%>%
            separate(V1,c('layer1','layer2','layer3'),sep = '-')%>%
            filter(layer1=='Inflow')%>%pull(layer3)%>%unique))->color_tibble

```

Row
-------------------------------------

### Svend Brinkman
```{r}
sunburst_data%>%
    filter(user_name=='Brinkmann, Svend')%>%
      #mutate(V2=ifelse(V2>0,1,0))%>%
       select(-user_name)%>%
        sunburst(colors = list(range=color_tibble$colors,
                                domain=color_tibble$labels),legend=FALSE)
```
### Rikke Magnusen
```{r}
sunburst_data%>%
    filter(user_name=='Magnussen, Rikke')%>%
      #mutate(V2=ifelse(V2>0,1,0))%>%
       select(-user_name)%>%
        sunburst(colors = list(range=color_tibble$colors,
                                domain=color_tibble$labels),legend=FALSE)
```

Row
-------------------------------------

### Rikke Kristine Nielsen
```{r}
sunburst_data%>%
    filter(user_name=='Nielsen, Rikke Kristine')%>%
      #mutate(V2=ifelse(V2>0,1,0))%>%
       select(-user_name)%>%
        sunburst(colors = list(range=color_tibble$colors,
                                domain=color_tibble$labels),legend=FALSE)
```


### Music Therapy
```{r}
sunburst_data%>%
    filter(user_name=='Ridder, Hanne Mette Ochsner')%>%
      #mutate(V2=ifelse(V2>0,1,0))%>%
       select(-user_name)%>%
        sunburst(colors = list(range=color_tibble$colors,
                                domain=color_tibble$labels),legend=FALSE)
```


Analysis {data-icon="fa-cog"} 
================================
Column {.tabset .tabset-fade}
-----------------------------------------------------------------------


### Heatmap {data-height=1200} 

```{r}
top_5_each<-c('TeachingActivity - HigherEducation',
                          'FieldActivities - Meeting',
                              'AcademicEvent - Meeting',
                                  'AcademicEvent - Seminar',
                                    'AcademicEvent - Conference',
                            'AcademicProduct - Paper',
                        'AcademicProduct - Chapter',
                            'MediaProduct - ArticleJournalism',
              'AcademicProduct - Manuscript','AcademicProduct - Abstract',
              'Inflow - PopularMention','Inflow - PopularCitation',
              'Request - Collaboration','Request - Advice','Request - Text')

all_data_final_long%>%filter(category%in%top_5_each)%>%
                pivot_wider(names_from=category,values_from = count)%>%
          select(-position)%>%column_to_rownames('user_name')->data_for_heatmap

d3heatmap(data_for_heatmap,
              scale = 'column',
                  col = 'Blues',
                  na.color = 'Darkblue',
                    dendrogram = 'row',
                        k_row=4,
                          cexCol = 0.8,cexRow = 0.8,
                            height =900,width = 700,
                              labColSize = 200,labRowSize = 200)

```

### Activity Diversity Value
```{r}
#How diverse are participants in their activities
#i.e. among all possible 

all_data_final_long%>%mutate(count = ifelse(count == 0,0,1))%>%
                        group_by(user_name,position)%>%
                            summarise(count_activities = sum(count),
                                      total_cats=n(),
                                      adv = count_activities/total_cats)%>%
                          mutate(position = firstup(position))%>%
    ggplot(mapping = aes(x=position,y=adv))+
        geom_violin(aes(color = position, 
                            fill = position),alpha=0.6)+
          geom_jitter(width = 0.2,
              aes(color=position,fill=position,
                text=paste('Participant: ',
                      user_name,'\nActivity Diversity Value: ',adv)))+
          theme_minimal()+
            labs(y='Activity Diversity Value',
                    x='',fill='',color='')->adv_plot

ggplotly(adv_plot,tooltip = c('text'))
```

### Activity Diversity vs. Total Publications


```{r}
all_data_final_long%>%mutate(count = ifelse(count == 0,0,1))%>%
                        group_by(user_name,position)%>%
                            summarise(count_activities = sum(count),
                                      total_cats=n(),
                                      adv = count_activities/total_cats)%>%
                          mutate(position = firstup(position))%>%
        left_join(pure_bfi_complete,by=c('user_name'='author_name'))->react_pure_data

react_pure_data%>%
    ggplot(aes(x=adv,y=publications_total))+
             geom_point(aes(color=position,text=paste('Participant: ',user_name,
                      '\nActivity Diversity Value:',adv,
                      '\nTotal Publications:',publications_total)))+
                          geom_smooth()+theme_minimal()+
                            labs(x='Activity Diversity Value',y='Total Publications',color='')->adv_total_pubs

ggplotly(adv_total_pubs,tooltip = c('text'))

```

### Activity Diversity vs. Total BFI Points

```{r}
react_pure_data%>%
    ggplot(aes(x=adv,y=total_bfi_points))+
             geom_point(aes(color=position,text=paste('Participant: ',user_name,
                      '\nActivity Diversity Value:',adv,
                      '\nTotal BFI Points:',total_bfi_points)))+
                          geom_smooth()+theme_minimal()+
                            labs(x='Activity Diversity Value',y='Total BFI Points',color='')->adv_total_bfi

ggplotly(adv_total_bfi,tooltip = c('text'))

```
### Activity Diversity vs. Citations

```{r}
react_pure_data%>%
    ggplot(aes(x=adv,y=citations_total_per_person))+
             geom_point(aes(color=position,text=paste('Participant: ',user_name,
                      '\nActivity Diversity Value:',adv,
                      '\nTotal Citations:',citations_total_per_person)))+
                          geom_smooth()+theme_minimal()+
                            labs(x='Activity Diversity Value',y='Total Citations',color='')->adv_total_bfi

ggplotly(adv_total_bfi,tooltip = c('text'))

```

### Activity Diversity vs. Downloads

```{r}
react_pure_data%>%
    ggplot(aes(x=adv,y=downloads_total_per_person))+
             geom_point(aes(color=position,text=paste('Participant: ',user_name,
                      '\nActivity Diversity Value:',adv,
                      '\nTotal Downloads:',downloads_total_per_person)))+
                          geom_smooth()+theme_minimal()+
                            labs(x='Activity Diversity Value',y='Total Downloads',color='')->adv_total_bfi

ggplotly(adv_total_bfi,tooltip = c('text'))

```




### Inputs {.sidebar}
-------------------------------------
Bla bla bla